home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0059_UU Encode files.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-26  |  3KB  |  158 lines
  1. {
  2.    Pascal program to UUDECODE files which were processed
  3.    with UUENCODE.  Or it will DECODE files which were
  4.    processed by ENCODE
  5.  
  6.    Paul Robinson  TDARCOS@MCIMAIL.COM
  7.    Tansin A. Darcos & Company
  8.    June 26, 1993
  9. }
  10.  
  11. var inf,outf:text;
  12.     open:boolean;
  13.     ch:char;
  14.     buflen,tag:char;
  15.     tagfiller:array[1..80] of char;
  16.     buf:string[80]  absolute buflen;
  17.     tag3:array[1..3] of char absolute tag;
  18.     tag6:array[1..6] of char absolute tag;
  19.     outfn:string[80];
  20.     bp,n:integer;
  21.  
  22. function dec(c:char):byte;
  23. begin
  24.    dec := (ord(c) - ord(' ')) and 63
  25. end;
  26.  
  27. procedure short(msg:string);
  28. begin
  29.    writeln(msg);
  30.    close(inf);
  31.    if open then
  32.       close(outf);
  33.    halt(1);
  34. end;
  35.  
  36.  
  37. procedure skip;
  38. begin
  39.    while buf[bp] = ' ' do
  40.      begin
  41.         bp := bp+1;
  42.         if bp>=length(buf) then
  43.           short('Error 01 Bad begin line');
  44.      end;
  45.    while buf[bp] <> ' ' do
  46.      begin
  47.         bp := bp+1;
  48.         if bp>=length(buf) then
  49.           short('Error 02 Bad begin line');
  50.      end;
  51.    while buf[bp] = ' ' do
  52.      begin
  53.         bp := bp+1;
  54.         if bp>=length(buf) then
  55.           short('Error 03 Bad begin line');
  56.      end;
  57.     while (buf[bp] <> ' ') do
  58.      begin
  59.         outfn := outfn+buf[bp];
  60.         bp := bp+1;
  61.      end;
  62. end;
  63.  
  64.  
  65.  
  66. {  output a group of 3 bytes (4 input characters).
  67.    the input chars are pointed to by bp.
  68.    n is used to tell us not to output all of them
  69.    at the end of the file.
  70. }
  71.  
  72. procedure outdec(bp,n:integer);
  73. var c1,c2,c3:byte;
  74. begin
  75.    c1 := (DEC(buf[bp]) shl 2)  or (dec(buf[bp+1]) shr 4);
  76.    c2 := (dec(buf[bp+1]) shl 4) or (dec(buf[bp+2]) shr 2);
  77.    c3 := (dec(buf[bp+2]) shl 6) or dec(buf[bp+3]);
  78.    if n >= 1 then
  79.      write(outf,chr(c1));
  80.    if n >= 2 then
  81.      write(outf,chr(c2));
  82.    if n >= 3 then
  83.      write(outf,chr(c3));
  84. end;
  85.  
  86. procedure decode;
  87. begin
  88.    if eof(inf) then
  89.      short('Premature EOF');
  90.    repeat
  91.    readln(inf,buf);
  92.    if length(buf)>0 then
  93.      begin
  94.        n := dec(buf[1]);
  95.        if n > 0 then
  96.          begin
  97.             bp := 2;
  98.             while n>0 do
  99.             begin
  100.                outdec(bp, n);
  101.                bp := bp+4;
  102.                n := n-3;
  103.             end;
  104.          end;
  105.     end;
  106.     until length(buf)<2;
  107. end;
  108.  
  109.  
  110.  
  111. begin
  112.    if (paramcount <1) or ((paramcount >=1) and (paramstr(1)='/?'))  then
  113.      begin
  114.         writeln('Pascal UUDECODER by Paul Robinson - TDARCOS@MCIMAIL.COM');
  115.         writeln('Usage: DECODE filename');
  116.         halt(0);
  117.      end;
  118.    assign(inf,paramstr(1));
  119.    open := false;
  120.  
  121.    {$I-} reset(inf); {$I+}
  122.    if IORESULT <> 0 then
  123.      short('File '+paramstr(1)+' cannot be opened.');
  124.    if not eof(inf) then
  125.       readln(inf,buf)
  126.    else
  127.       short('Empty file');
  128.    while tag6 <> 'begin ' do
  129.       if not eof(inf) then
  130.          readln(inf,buf)
  131.       else
  132.         short('No begin line');
  133.     bp := 6;
  134.     buf := buf+' ';
  135.  
  136. {
  137.     format is 'begin nnn filename'
  138.     skip spaces before the nnn
  139.     skip the nnn
  140.     skip spaces after the nnn
  141. }
  142.     skip;
  143.     assign(outf,outfn);
  144. {$I-}     rewrite(outf);  {$I+}
  145.     if IORESULT = 0 then
  146.        open := true
  147.     else
  148.        short('Cannot create file '+outfn);
  149.  
  150.     decode;
  151.     readln(inf,buf);
  152.     if tag3 <> 'end' then
  153.       short('Warning: no end line');
  154.     close(inf);
  155.     if open then
  156.       close(outf);
  157. end.
  158.